'From Pharo1.2.1 of 2 April 2011 [Latest update: #12345] on 18 October 2011 at 8:31:03 pm'!CodeHolder subclass: #Browser	instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated'	classVariableNames: 'RecentClasses'	poolDictionaries: ''	category: 'Tools-Browser'!!Browser commentStamp: '<historical>' prior: 0!I represent a query path into the class descriptions, the software of the system.!!Browser methodsFor: '*Polymorph-Widgets-override' stamp: 'tbn 8/1/2010 14:06'!buildMorphicSwitches	| instanceSwitch commentSwitch classSwitch row |	instanceSwitch := PluggableButtonMorph		on: self		getState: #instanceMessagesIndicated		action: #indicateInstanceMessages.	instanceSwitch		label: 'Instance';		askBeforeChanging: true;		setBalloonText: 'Display instance side';		borderWidth: 1;		borderColor: Color gray.	commentSwitch := PluggableButtonMorph		on: self		getState: #classCommentIndicated		action: #plusButtonHit.			commentSwitch		label: '?' asText allBold;		askBeforeChanging: true;		setBalloonText: 'Cycle among definition, comment, and hierachy';		borderWidth: 1;		borderColor: Color gray.	classSwitch := PluggableButtonMorph		on: self		getState: #classMessagesIndicated		action: #indicateClassMessages.	classSwitch		label: 'Class';		askBeforeChanging: true;		setBalloonText: 'Display class side';				borderWidth: 1;		borderColor: Color gray.	row := AlignmentMorph newRow		hResizing: #spaceFill;		vResizing: #spaceFill;		cellInset: 0;		borderWidth: 0;		layoutInset: 0;		addMorphBack: instanceSwitch;		addMorphBack: commentSwitch;		addMorphBack: classSwitch.	row color: Color white.	{instanceSwitch. commentSwitch. classSwitch} do: [:m | 		m 			color: Color transparent;			hResizing: #spaceFill;			vResizing: #spaceFill.].	^OverflowRowMorph new		baseMorph: row;		height: row minExtent y! !!Browser methodsFor: '*Shout-Styling'!shoutAboutToStyle: aPluggableShoutMorphOrView 	| type |	self shoutIsModeStyleable		ifFalse: [^ false].	type := self editSelection.	(#(#newMessage #editMessage #editClass #newClass ) includes: type)		ifFalse: [^ false].	aPluggableShoutMorphOrView		classOrMetaClass: (type = #editClass				ifFalse: [self selectedClassOrMetaClass]).	^ true! !!Browser methodsFor: '*SimpleMorphic' stamp: 'JuanVuletich 10/18/2010 16:09'!smxWindowColor	^Color lightGreen! !!Browser methodsFor: '*deprecated12' stamp: 'StephaneDucasse 1/7/2011 17:37'!methodReference 	| cls sel |	self deprecated: 'Apparently this is not used' on:  '7 January 2011' in: 'Pharo1.2'.	cls := self selectedClassOrMetaClass.	sel := self selectedMessageName.	cls isNil | sel isNil ifTrue: [^nil].	^ SourcedMethodReference class: cls selector: sel! !!Browser methodsFor: 'accessing' stamp: 'al 12/6/2005 22:36'!contents	"Depending on the current selection, different information is retrieved.	Answer a string description of that information. This information is the	method of the currently selected class and message."	| comment theClass latestCompiledMethod |	latestCompiledMethod := currentCompiledMethod.	currentCompiledMethod := nil.	editSelection == #newTrait		ifTrue: [^Trait newTemplateIn: self selectedSystemCategoryName].	editSelection == #none ifTrue: [^ ''].	editSelection == #editSystemCategories 		ifTrue: [^ systemOrganizer printString].	editSelection == #newClass 		ifTrue: [^ (theClass := self selectedClass)			ifNil:				[Class template: self selectedSystemCategoryName]			ifNotNil:				[Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]].	editSelection == #editClass 		ifTrue: [^self classDefinitionText].	editSelection == #editComment 		ifTrue:			[(theClass := self selectedClass) ifNil: [^ ''].			comment := theClass comment.			currentCompiledMethod := theClass organization commentRemoteStr.			^ comment size = 0				ifTrue: ['This class has not yet been commented.']				ifFalse: [comment]].	editSelection == #hierarchy 		ifTrue: [			self selectedClassOrMetaClass isTrait				ifTrue: [^'']				ifFalse: [^self selectedClassOrMetaClass printHierarchy]].	editSelection == #editMessageCategories 		ifTrue: [^ self classOrMetaClassOrganizer printString].	editSelection == #newMessage		ifTrue:			[^ (theClass := self selectedClassOrMetaClass) 				ifNil: ['']				ifNotNil: [theClass sourceCodeTemplate]].	editSelection == #editMessage		ifTrue:			[self showingByteCodes ifTrue: [^ self selectedBytecodes].			currentCompiledMethod := latestCompiledMethod.			^ self selectedMessage].	self error: 'Browser internal error: unknown edit selection.'! !!Browser methodsFor: 'accessing' stamp: 'tak 9/25/2008 14:58'!contentsSelection	"Return the interval of text in the code pane to select when I set the pane's contents"	messageCategoryListIndex > 0 & (messageListIndex = 0)		ifTrue: [^ 1 to: 500]	"entire empty method template"		ifFalse: [^ 1 to: 0]		"null selection"! !!Browser methodsFor: 'accessing' stamp: 'MarcusDenker 10/24/2010 16:59'!couldBrowseAnyClass	"Answer whether the receiver is equipped to browse any class. This is in	support of the system-brower feature that allows the browser to be	redirected at the selected class name. This implementation is clearly	ugly, but the feature it enables is handsome enough. 3/1/96 sw"	self dependents		detect: [:d | (d respondsTo: #getListSelector)				and: [d getListSelector == #systemCategoryList]]		ifNone: [^ false].	^ true! !!Browser methodsFor: 'accessing' stamp: 'sma 5/28/2000 11:28'!doItReceiver	"This class's classPool has been jimmied to be the classPool of the class 	being browsed. A doIt in the code pane will let the user see the value of 	the class variables."	^ self selectedClass ifNil: [FakeClassPool new]! !!Browser methodsFor: 'accessing'!editSelection	^editSelection! !!Browser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!editSelection: aSelection	"Set the editSelection as requested."	editSelection := aSelection.	self changed: #editSelection.! !!Browser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!noteSelectionIndex: anInteger for: aSymbol	aSymbol == #systemCategoryList		ifTrue:			[systemCategoryListIndex := anInteger].	aSymbol == #classList		ifTrue:			[classListIndex := anInteger].	aSymbol == #messageCategoryList		ifTrue:			[messageCategoryListIndex := anInteger].	aSymbol == #messageList		ifTrue:			[messageListIndex := anInteger].! !!Browser methodsFor: 'accessing' stamp: 'rbb 3/1/2005 10:26'!request: prompt initialAnswer: initialAnswer	^ UIManager default		request: prompt		initialAnswer: initialAnswer! !!Browser methodsFor: 'annotation' stamp: 'sd 11/20/2005 21:26'!annotation	"Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver."	|  aSelector aClass |	(aClass := self selectedClassOrMetaClass) == nil ifTrue: [^ '------'].	self editSelection == #editComment ifTrue:		[^ self annotationForSelector: #Comment ofClass: aClass].	self editSelection == #editClass ifTrue:		[^ self annotationForSelector: #Definition ofClass: aClass].	(aSelector := self selectedMessageName) ifNil: [^ '------'].	^ self annotationForSelector: aSelector ofClass: aClass! !!Browser methodsFor: 'breakpoints' stamp: 'marcus.denker 10/9/2008 20:32'!toggleBreakOnEntry	"Install or uninstall a halt-on-entry breakpoint"	super toggleBreakOnEntry.	self changed: #messageList		! !!Browser methodsFor: 'class comment pane' stamp: 'AlainPlantec 1/7/2010 21:39'!buildMorphicCommentPane	"Construct the pane that shows the class comment.	Respect the setting StandardFonts codeFont."	| commentPane |	commentPane := BrowserCommentTextMorph				on: self				text: #classCommentText				accept: #classComment:notifying:				readSelection: nil				menu: #codePaneMenu:shifted:.	commentPane font: StandardFonts codeFont.	^ commentPane! !!Browser methodsFor: 'class comment pane' stamp: 'JB 2/12/2010 15:22'!classComment: aText notifying: aPluggableTextMorph 	"The user has just entered aText.	It may be all red (a side-effect of replacing the default comment), so remove the color if it is."	| theClass cleanedText redRange |	theClass := self selectedClassOrMetaClass.	theClass		ifNotNil: [cleanedText := aText asText.			redRange := cleanedText rangeOf: TextColor red startingAt: 1.			redRange size = cleanedText size				ifTrue: [cleanedText						removeAttribute: TextColor red						from: 1						to: redRange last ].			theClass comment: aText stamp: Author changeStamp].	self changed: #classCommentText.	^ true! !!Browser methodsFor: 'class comment pane' stamp: 'md 2/24/2006 15:23'!noCommentNagString	^ Text string: 'THIS CLASS HAS NO COMMENT!!' translated attribute: TextColor red.		! !!Browser methodsFor: 'class functions' stamp: 'StephaneDucasse 12/5/2009 21:25'!addAllMethodsToCurrentChangeSet	"Add all the methods in the selected class or metaclass to the current change set.  You ought to know what you're doing before you invoke this!!"	| aClass |	(aClass := self selectedClassOrMetaClass) ifNotNil:		[aClass selectorsDo:			[:sel |				ChangeSet current adoptSelector: sel forClass: aClass].		self changed: #annotation]! !!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!classCommentText	"return the text to display for the comment of the currently selected class"	| theClass |	theClass := self selectedClassOrMetaClass.	theClass ifNil: [ ^''].	^ theClass hasComment		ifTrue: [  theClass comment  ]		ifFalse: [ self noCommentNagString ]! !!Browser methodsFor: 'class functions' stamp: 'eem 5/7/2008 12:04'!classDefinitionText	"return the text to display for the definition of the currently selected class"	| theClass |	^(theClass := self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass definition]! !!Browser methodsFor: 'class functions' stamp: 'sw 12/6/2000 16:32'!classListMenu: aMenu 	"For backward compatibility with old browers stored in image segments"	^ self classListMenu: aMenu shifted: false! !!Browser methodsFor: 'class functions' stamp: 'tbn 7/6/2010 16:05'!classListMenu: aMenu shifted: shifted	"Set up the menu to apply to the receiver's class list, honoring the #shifted boolean"	shifted		ifTrue:			[^ self shiftedClassListMenu: aMenu].	aMenu addList: #(		-		('Browse full (b)'			browseMethodFull)		('Browse hierarchy (h)'		spawnHierarchy)		('Browse protocol (p)'		browseFullProtocol)		-		('FileOut'					fileOutClass)		-		('Show hierarchy'			hierarchy)		('Show definition'			editClass)		('Show comment'			editComment)		-		('Inst var refs...'			browseInstVarRefs)		('Inst var defs...'			browseInstVarDefs)		-		('Class var refs...'			browseClassVarRefs)		('Class vars'					browseClassVariables)		('Class refs (N)'				browseClassRefs)		-		('Rename class ...'			renameClass)		('Copy class'				copyClass)		('Remove class (x)'			removeClass)		-		('Find method...'				findMethod)		('Find method wildcard...'	findMethodWithWildcard)		-		('More...'					offerShiftedClassListMenu)).	^ aMenu! !!Browser methodsFor: 'class functions' stamp: 'DamienCassou 9/29/2009 09:05'!copyClass	| copysName |	classListIndex = 0		ifTrue: [^ self].	self okToChange		ifFalse: [^ self].	copysName := self request: 'Please type new class name' initialAnswer: self selectedClass name.	copysName isEmptyOrNil		ifTrue: [^ self].	"Cancel returns ''"	self selectedClass duplicateClassWithNewName: copysName.	self classListIndex: 0.	self changed: #classList! !!Browser methodsFor: 'class functions' stamp: 'StephaneDucasse 5/13/2010 11:43'!createInstVarAccessors	"Create getters and setters for all inst vars defined at the level of the current class selection, except do NOT clobber or override any selectors already understood by the instances of the selected class"	| aClass |	(aClass := self selectedClassOrMetaClass) ifNotNil:		[aClass instVarNames do: 			[:aName | | setter newMessage |				(aClass canUnderstand: aName asSymbol)					ifFalse:						[newMessage := aName, '	^ ', aName.						aClass compile: newMessage classified: 'accessing' notifying: nil].				(aClass canUnderstand: (setter := aName, ':') asSymbol)					ifFalse:						[newMessage := setter, ' anObject	', aName, ' := anObject'.						aClass compile: newMessage classified: 'accessing' notifying: nil]]]! !!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 3/26/2010 16:48'!defineClass: defString notifying: aController  	"The receiver's textual content is a request to define a new class. The	source code is defString. If any errors occur in compilation, notify	aController."	| oldClass class newClassName defTokens keywdIx envt |	oldClass := self selectedClassOrMetaClass.	defTokens := defString findTokens: Character separators.		((defTokens first = 'Trait' and: [defTokens second = 'named:'])		or: [defTokens second = 'classTrait'])		ifTrue: [^self defineTrait: defString notifying: aController].			keywdIx := defTokens findFirst: [:x | x beginsWith: 'category'].	envt := Smalltalk globals.	keywdIx := defTokens findFirst: [:x | '*subclass*' match: x].	newClassName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.	((oldClass isNil or: [oldClass theNonMetaClass name asString ~= newClassName])		and: [envt includesKey: newClassName asSymbol]) ifTrue:			["Attempting to define new class over existing one when				not looking at the original one in this browser..."			(self confirm: ((newClassName , ' is an existing class in this system.Redefining it might cause serious problems.Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size))				ifFalse: [^ false]].	"ar 8/29/1999: Use oldClass superclass for defining oldClass	since oldClass superclass knows the definerClass of oldClass."	oldClass ifNotNil:[oldClass := oldClass superclass].	class := oldClass subclassDefinerClass				evaluate: defString				notifying: aController				logged: true.	(class isKindOf: Behavior)		ifTrue: [self changed: #systemCategoryList.				self changed: #classList.				self clearUserEditFlag.				self setClass: class selector: nil.				"self clearUserEditFlag; editClass."				^ true]		ifFalse: [^ false]! !!Browser methodsFor: 'class functions' stamp: 'nk 2/15/2004 13:23'!editClass	"Retrieve the description of the class definition."	classListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	self messageCategoryListIndex: 0.	self editSelection: #editClass.	self changed: #contents.	self changed: #classCommentText.! !!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!editComment	"Retrieve the description of the class comment."	classListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	self messageCategoryListIndex: 0.	metaClassIndicated := false.	self editSelection: #editComment.	self changed: #classSelectionChanged.	self changed: #messageCategoryList.	self changed: #messageList.	self decorateButtons.	self contentsChanged! !!Browser methodsFor: 'class functions' stamp: 'menegazzo 10/18/2011 20:31'!fileOutClass	"Print a description of the selected class onto a file whose name is the 	category name followed by .st."	Cursor write showWhile: [		classListIndex ~= 0 ifTrue: [			self selectedClass fileOut: '/home/michelmenega/planseq'.		]	]! !!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 3/5/2010 14:30'!findMethod	"Pop up a list of the current class's methods, and select the one chosen by the user"	| aClass selectors reply cat messageCatIndex messageIndex choices |	self classListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	aClass := self selectedClassOrMetaClass.	selectors := aClass selectors sort.	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.' translated. ^ self].	choices := (Array with: 'Enter Wildcard' translated), selectors.	reply := UIManager default chooseFrom: choices lines: #(1).	reply = 0 ifTrue: [^self].	reply = 1		ifTrue: [			reply := UIManager default request: 'Enter partial method name:' translated.			(reply isNil or: [reply isEmpty])				ifTrue: [^self].			(reply includes: $*)				ifFalse: [reply := '*', reply, '*'].			selectors := selectors select: [:each | reply match: each].			selectors isEmpty ifTrue: [self inform: aClass name, ' has no matching methods.' translated. ^ self].			reply := selectors size = 1				ifTrue: [selectors first]				ifFalse: [	UIManager default chooseFrom: selectors values: selectors].			reply isNil ifTrue: [^self]]		ifFalse: [reply := choices at: reply].	cat := aClass whichCategoryIncludesSelector: reply.	messageCatIndex := self messageCategoryList indexOf: cat.	self messageCategoryListIndex: messageCatIndex.	messageIndex := (self messageList indexOf: reply).	self messageListIndex: messageIndex! !!Browser methodsFor: 'class functions' stamp: 'MarcusDenker 3/5/2010 14:30'!findMethodWithWildcard	"Pop up a list of the current class's methods, and select the one chosen by the user"	| aClass selectors reply cat messageCatIndex messageIndex |	self classListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	aClass := self selectedClassOrMetaClass.	selectors := aClass selectors sort.	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.' translated. ^ self].	reply := UIManager default request: 'Enter partial method name:' translated.	(reply isNil or: [reply isEmpty])		ifTrue: [^self].	(reply includes: $*)		ifFalse: [reply := '*', reply, '*'].	selectors := selectors select: [:each | reply match: each].	selectors isEmpty ifTrue: [self inform: aClass name, ' has no matching methods.'. ^ self].	reply := selectors size = 1		ifTrue: [selectors first]		ifFalse: [UIManager default chooseFrom: selectors values: selectors].	reply == nil ifTrue: [^ self].	cat := aClass whichCategoryIncludesSelector: reply.	messageCatIndex := self messageCategoryList indexOf: cat.	self messageCategoryListIndex: messageCatIndex.	messageIndex := (self messageList indexOf: reply).	self messageListIndex: messageIndex! !!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:09'!hierarchy	"Display the inheritance hierarchy of the receiver's selected class."	classListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	self messageCategoryListIndex: 0.	self editSelection: #hierarchy.	self changed: #editComment.	self contentsChanged.	^ self! !!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:07'!makeNewSubclass	self selectedClassOrMetaClass ifNil: [^ self].	self okToChange ifFalse: [^ self].	self editSelection: #newClass.	self contentsChanged! !!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:09'!plusButtonHit	"Cycle among definition, comment, and hierachy"	editSelection == #editComment		ifTrue: [self hierarchy. ^ self].	editSelection == #hierarchy		ifTrue: [self editSelection: #editClass.			classListIndex = 0 ifTrue: [^ self].			self okToChange ifFalse: [^ self].			self changed: #editComment.			self contentsChanged.			^ self].	self editComment! !!Browser methodsFor: 'class functions' stamp: 'sw 3/5/2001 18:04'!removeClass	"If the user confirms the wish to delete the class, do so"	super removeClass ifTrue:		[self classListIndex: 0]! !!Browser methodsFor: 'class functions' stamp: 'StephaneDucasse 4/28/2010 12:25'!renameClass	| oldName newName obs |	classListIndex = 0		ifTrue: [ ^ self ].	self okToChange		ifFalse: [ ^ self ].	oldName := self selectedClass name.	newName := self request: 'Please type new class name' initialAnswer: oldName.	newName isEmptyOrNil		ifTrue: [ ^ self ].	"Cancel returns ''"	newName := newName asSymbol.	newName = oldName		ifTrue: [ ^ self ].	(Smalltalk globals includesKey: newName)		ifTrue: [ ^ self error: newName , ' already exists' ].	self selectedClass rename: newName.	self changed: #classList.	self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName).	obs := self systemNavigation allReferencesTo: (self selectedClass environment associationAt: newName).	obs isEmpty		ifFalse: [ self systemNavigation browseMessageList: obs name: 'Obsolete References to ' , oldName autoSelect: oldName ]! !!Browser methodsFor: 'class functions' stamp: 'tbn 7/29/2010 21:59'!shiftedClassListMenu: aMenu	"Set up the menu to apply to the receiver's class list when the shift key is down"	^ aMenu addList: #(			-			('Unsent methods'			browseUnusedMethods	'Browse all methods defined by this class that have no senders')			('Unreferenced inst vars'	showUnreferencedInstVars	'Show a list of all instance variables that are not referenced in methods')			('Unreferenced class vars'	showUnreferencedClassVars	'Show a list of all class variables that are not referenced in methods')			('Subclass template'			makeNewSubclass		'Put a template into the code pane for defining of a subclass of this class')			-			('Sample instance'			makeSampleInstance		'Give me a sample instance of this class, if possible')			('Inspect instances'			inspectInstances			'Open an inspector on all the extant instances of this class')			('Inspect subinstances'		inspectSubInstances		'Open an inspector on all the extant instances of this class and of all of its subclasses')			-			('Add all meths to current chgs'		addAllMethodsToCurrentChangeSet																'Place all the methods defined by this class into the current change set')			('Create inst var accessors'	createInstVarAccessors	'Compile instance-variable access methods for any instance variables that do not yet have them')			-			('More...'					offerUnshiftedClassListMenu	'Return to the standard class-list menu'))! !!Browser methodsFor: 'class list'!classList	"Answer an array of the class names of the selected category. Answer an 	empty array if no selection exists."	systemCategoryListIndex = 0		ifTrue: [^Array new]		ifFalse: [^systemOrganizer listAtCategoryNumber: systemCategoryListIndex]! !!Browser methodsFor: 'class list'!classListIndex	"Answer the index of the current class selection."	^classListIndex! !!Browser methodsFor: 'class list' stamp: 'StephaneDucasse 2/14/2011 12:48'!classListIndex: anInteger 	"Set anInteger to be the index of the current class selection."	| className |	self beUnStyled.	classListIndex := anInteger.	self setClassOrganizer.	messageCategoryListIndex := 0.	messageListIndex := 0.	self classCommentIndicated		ifTrue: []		ifFalse: [self editSelection: (anInteger = 0					ifTrue: [metaClassIndicated | (systemCategoryListIndex == 0)						ifTrue: [#none]						ifFalse: [#newClass]]					ifFalse: [#editClass])].	contents := nil.	self selectedClass isNil		ifFalse: [className := self selectedClass name.					(RecentClasses includes: className)				ifTrue: [RecentClasses remove: className].			RecentClasses addFirst: className.			RecentClasses size > 16				ifTrue: [RecentClasses removeLast]].	self changed: #classSelectionChanged.	self changed: #classCommentText.	self changed: #classListIndex.	"update my selection"	self changed: #messageCategoryList.	self changed: #messageList.	self changed: #relabel.	self contentsChanged! !!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!classListSingleton	| name |	name := self selectedClassName.	^ name ifNil: [Array new]		ifNotNil: [Array with: name]! !!Browser methodsFor: 'class list' stamp: 'lr 3/14/2010 21:13'!recent	"Let the user select from a list of recently visited classes.  11/96 stp.	 12/96 di:  use class name, not classes themselves.	 : dont fall into debugger in empty case"	| className class recentList |	recentList := RecentClasses select: [ :n | Smalltalk globals includesKey: n ].	recentList size == 0		ifTrue: [ ^ Beeper beep ].	className := UIManager default chooseFrom: recentList values: recentList.	className isNil		ifTrue: [ ^ self ].	class := Smalltalk globals at: className.	self selectCategoryForClass: class.	self classListIndex: (self classList indexOf: class name)! !!Browser methodsFor: 'class list' stamp: 'sr 10/29/1999 20:28'!selectClass: classNotMeta	self classListIndex: (self classList indexOf: classNotMeta name)! !!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!selectedClass	"Answer the class that is currently selected. Answer nil if no selection 	exists."	| name envt |	(name := self selectedClassName) ifNil: [^ nil].	(envt := self selectedEnvironment) ifNil: [^ nil].	^ envt at: name! !!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!selectedClassName	| aClassList |	"Answer the name of the current class. Answer nil if no selection exists."	(classListIndex = 0 or: [classListIndex > (aClassList := self classList) size]) ifTrue: [^ nil].	^ aClassList at: classListIndex! !!Browser methodsFor: 'code pane' stamp: 'AlainPlantec 1/7/2010 21:06'!codePaneMenu: aMenu shifted: shifted 	super codePaneMenu: aMenu shifted: shifted.	^ aMenu! !!Browser methodsFor: 'code pane' stamp: 'sd 11/20/2005 21:26'!compileMessage: aText notifying: aController	"Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false."	| fallBackCategoryIndex fallBackMethodIndex originalSelectorName result |	self selectedMessageCategoryName ifNil:			[ self selectOriginalCategoryForCurrentMethod 											ifFalse:["Select the '--all--' category"											self messageCategoryListIndex: 1]]. 	self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory		ifTrue:			[ "User tried to save a method while the ALL category was selected"			fallBackCategoryIndex := messageCategoryListIndex.			fallBackMethodIndex := messageListIndex.			editSelection == #newMessage				ifTrue:					[ "Select the 'as yet unclassified' category"					messageCategoryListIndex := 0.					(result := self defineMessageFrom: aText notifying: aController)						ifNil:							["Compilation failure:  reselect the original category & method"							messageCategoryListIndex := fallBackCategoryIndex.							messageListIndex := fallBackMethodIndex]						ifNotNil:							[self setSelector: result]]				ifFalse:					[originalSelectorName := self selectedMessageName.					self setOriginalCategoryIndexForCurrentMethod.					messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName.								(result := self defineMessageFrom: aText notifying: aController)						ifNotNil:							[self setSelector: result]						ifNil:							[ "Compilation failure:  reselect the original category & method"							messageCategoryListIndex := fallBackCategoryIndex.							messageListIndex := fallBackMethodIndex.							^ result notNil]].			self changed: #messageCategoryList.			^ result notNil]		ifFalse:			[ "User tried to save a method while the ALL category was NOT selected"			^ (self defineMessageFrom: aText notifying: aController) notNil]! !!Browser methodsFor: 'construction' stamp: 'AlainPlantec 11/17/2010 11:35'!addLowerPanesTo: window at: nominalFractions with: editString	| commentPane |	super addLowerPanesTo: window at: nominalFractions with: editString.	commentPane := self buildMorphicCommentPane.	window addMorph: commentPane fullFrame: commentPane defaultLayoutFrame.	self changed: #editSelection.! !!Browser methodsFor: 'copying' stamp: 'sd 11/20/2005 21:26'!veryDeepInner: deepCopier	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  See DeepCopier class comment."super veryDeepInner: deepCopier."systemOrganizer := systemOrganizer. 	clone has the old value. we share it""classOrganizer := classOrganizer		clone has the old value. we share it""metaClassOrganizer 	:= metaClassOrganizer	clone has the old value. we share it"systemCategoryListIndex := systemCategoryListIndex veryDeepCopyWith: deepCopier.classListIndex := classListIndex veryDeepCopyWith: deepCopier.messageCategoryListIndex := messageCategoryListIndex veryDeepCopyWith: deepCopier.messageListIndex := messageListIndex veryDeepCopyWith: deepCopier.editSelection := editSelection veryDeepCopyWith: deepCopier.metaClassIndicated := metaClassIndicated veryDeepCopyWith: deepCopier.! !!Browser methodsFor: 'drag and drop' stamp: 'nk 6/12/2004 17:43'!acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph 	"Here we are fetching informations from the dropped transferMorph 	and  	performing the correct action for this drop."	| srcType success srcBrowser |	success := false.	srcType := transferMorph dragTransferType.	srcBrowser := transferMorph source model.	srcType == #messageList		ifTrue: [ | srcClass srcSelector srcCategory |			srcClass := transferMorph passenger key.			srcSelector := transferMorph passenger value.			srcCategory := srcBrowser selectedMessageCategoryName.			srcCategory				ifNil: [srcCategory := srcClass organization categoryOfElement: srcSelector].			success := self						acceptMethod: srcSelector						messageCategory: srcCategory						class: srcClass						atListMorph: dstListMorph						internal: self == srcBrowser						copy: transferMorph shouldCopy].	srcType == #classList		ifTrue: [success := self						changeCategoryForClass: transferMorph passenger						srcSystemCategory: srcBrowser selectedSystemCategoryName						atListMorph: dstListMorph						internal: self == srcBrowser						copy: transferMorph shouldCopy].	^ success! !!Browser methodsFor: 'drag and drop' stamp: 'nice 10/22/2009 15:13'!acceptMethod: methodSel dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel dstClass: dstClass dstClassOrMeta: dstClassOrMeta srcClassOrMeta: srcClassOrMeta internal: internal copySemantic: copyFlag 	| success hierarchyChange higher checkForOverwrite |	(success := dstClassOrMeta ~~ nil) ifFalse: [^false].	checkForOverwrite := dstClassOrMeta includesSelector: methodSel.	hierarchyChange := (higher := srcClassOrMeta inheritsFrom: dstClassOrMeta) | (dstClassOrMeta inheritsFrom: srcClassOrMeta).	success := (checkForOverwrite not				or: [self						overwriteDialogHierarchyChange: hierarchyChange						higher: higher						sourceClassName: srcClassOrMeta name						destinationClassName: dstClassOrMeta name						methodSelector: methodSel])				and: [self						message: methodSel						compileInClass: dstClassOrMeta						fromClass: srcClassOrMeta						dstMessageCategory: dstMessageCategorySel						srcMessageCategory: srcMessageCategorySel						internal: internal						copySemantic: copyFlag].	^ success! !!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 3/26/2010 16:49'!acceptMethod: methodSel messageCategory: srcMessageCategorySel class: srcClassOrMeta atListMorph: dstListMorph internal: internal copy: copyFlag 	| success dstClassOrMeta dstClass dstMessageCategorySel |	dstClass := self destinationClassDestinationListMorph: dstListMorph.	dstClassOrMeta := dstClass				ifNotNil: [self metaClassIndicated						ifTrue: [dstClass classSide]						ifFalse: [dstClass]].	dstMessageCategorySel := self dstMessageCategoryDstListMorph: dstListMorph.	success := (dstClassOrMeta notNil				and: [dstClassOrMeta == srcClassOrMeta])						ifTrue: ["one class"							self								changeMessageCategoryForMethod: methodSel								dstMessageCategory: dstMessageCategorySel								srcMessageCategory: srcMessageCategorySel								insideClassOrMeta: dstClassOrMeta								internal: internal								copySemantic: copyFlag]						ifFalse: ["different classes"							self								acceptMethod: methodSel								dstMessageCategory: dstMessageCategorySel								srcMessageCategory: srcMessageCategorySel								dstClass: dstClass								dstClassOrMeta: dstClassOrMeta								srcClassOrMeta: srcClassOrMeta								internal: internal								copySemantic: copyFlag].	^ success! !!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!changeCategoryForClass: class srcSystemCategory: srcSystemCategorySel atListMorph: dstListMorph internal: internal copy: copyFlag 	"only move semantic"	| newClassCategory success |	self flag: #stringSymbolProblem.	success := copyFlag not ifFalse: [^ false].	newClassCategory := self dstCategoryDstListMorph: dstListMorph.	(success := newClassCategory notNil & (newClassCategory ~= class category))		ifTrue: 			[class category: newClassCategory.			self changed: #classList.			internal ifFalse: [self selectClass: class]].	^ success! !!Browser methodsFor: 'drag and drop' stamp: 'nk 4/22/2004 18:00'!changeMessageCategoryForMethod: methodSel dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel insideClassOrMeta: classOrMeta internal: internal copySemantic: copyFlag 	"Recategorize the method named by methodSel. 	If the dstMessageCategorySel is the allCategory, then recategorize 	it from its parents."	| success messageCategorySel |	copyFlag		ifTrue: [^ false].	"only move semantic"	messageCategorySel := dstMessageCategorySel				ifNil: [srcMessageCategorySel].	(success := messageCategorySel notNil					and: [messageCategorySel ~= srcMessageCategorySel])		ifTrue: [success := messageCategorySel == ClassOrganizer allCategory						ifTrue: [self recategorizeMethodSelector: methodSel]						ifFalse: [(classOrMeta organization categories includes: messageCategorySel)								and: [classOrMeta organization										classify: methodSel										under: messageCategorySel										suppressIfDefault: false.									true]]].	success		ifTrue: [self changed: #messageList.			internal				ifFalse: [self setSelector: methodSel]].	^ success! !!Browser methodsFor: 'drag and drop' stamp: 'JB 2/12/2010 15:22'!contents: input notifying: aController 	"The retrieved information has changed and its source must now be	 updated. The information can be a variety of things, depending on	 the list selections (such as templates for class or message definition,	 methods) or the user menu commands (such as definition, comment,	 hierarchy).  Answer the result of updating the source."	| aString aText theClass |	self changed: #annotation.	aString := input asString.	aText := input asText.	editSelection == #newTrait ifTrue: [^self defineTrait: input asString notifying: aController].	editSelection == #editSystemCategories ifTrue: [^ self changeSystemCategories: aString].	editSelection == #editClass | (editSelection == #newClass) ifTrue: [^ self defineClass: aString notifying: aController].	editSelection == #editComment		ifTrue: 			[theClass := self selectedClass.			theClass				ifNil: 					[self inform: 'You must select a classbefore giving it a comment.'.					^ false].			theClass comment: aText stamp: Author changeStamp.			self changed: #classCommentText.			^ true].	editSelection == #hierarchy ifTrue: [^ true].	editSelection == #editMessageCategories ifTrue: [^ self changeMessageCategories: aString].	editSelection == #editMessage | (editSelection == #newMessage)		ifTrue:			[^ self okayToAccept				ifFalse:					[false]				ifTrue:					[self compileMessage: aText notifying: aController]].	editSelection == #none		ifTrue: 			[self inform: 'This text cannot be acceptedin this part of the browser.'.			^ false].	self error: 'unacceptable accept'! !!Browser methodsFor: 'drag and drop' stamp: 'MarcusDenker 3/26/2010 16:48'!destinationClassDestinationListMorph: dstListMorph	| dropItem |	^ dstListMorph getListSelector == #classList		ifTrue: [ (dropItem := dstListMorph potentialDropItem) ifNotNil: [ Smalltalk globals at: dropItem withBlanksCondensed asSymbol ] ]		ifFalse: [ dstListMorph model selectedClass ]! !!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!dragPassengerFor: item inMorph: dragSource 	| transferType smn |	(dragSource isKindOf: PluggableListMorph)		ifFalse: [^nil].	transferType := self dragTransferTypeForMorph: dragSource.	transferType == #classList		ifTrue: [^self selectedClass].	transferType == #messageList		ifFalse: [ ^nil ].	smn := self selectedMessageName ifNil: [ ^nil ].	(MessageSet isPseudoSelector: smn) ifTrue: [ ^nil ].	^ self selectedClassOrMetaClass -> smn.! !!Browser methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:18'!dragTransferTypeForMorph: dragSource 	^(dragSource isKindOf: PluggableListMorph)		ifTrue: [dragSource getListSelector]! !!Browser methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:21'!dstCategoryDstListMorph: dstListMorph	^(dstListMorph getListSelector == #systemCategoryList)		ifTrue: [dstListMorph potentialDropItem ]		ifFalse: [self selectedSystemCategoryName]! !!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!dstMessageCategoryDstListMorph: dstListMorph	| dropItem |	^dstListMorph getListSelector == #messageCategoryList		ifTrue: 			[dropItem := dstListMorph potentialDropItem.			dropItem ifNotNil: [dropItem asSymbol]]		ifFalse: [self selectedMessageCategoryName ifNil: [ Categorizer default ]]! !!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!message: messageSel compileInClass: dstClassOrMeta fromClass: srcClassOrMeta dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel internal: internal copySemantic: copyFlag 	| source messageCategorySel tm success oldOrNoMethod newMethod |	source := srcClassOrMeta sourceCodeAt: messageSel.	messageCategorySel := dstMessageCategorySel ifNil: [srcMessageCategorySel].	self selectClass: dstClassOrMeta theNonMetaClass.	(self messageCategoryList includes: messageCategorySel)		ifFalse: ["create message category"			self classOrMetaClassOrganizer addCategory: messageCategorySel].	self selectMessageCategoryNamed: messageCategorySel.	tm := self codeTextMorph.	tm setText: source.	tm setSelection: (0 to: 0).	tm hasUnacceptedEdits: true.	oldOrNoMethod := srcClassOrMeta compiledMethodAt: messageSel ifAbsent: [].	tm accept.	"compilation successful?"	newMethod := dstClassOrMeta compiledMethodAt: messageSel ifAbsent: [].	success := newMethod ~~ nil & (newMethod ~~ oldOrNoMethod).	"	success ifFalse: [TransferMorph allInstances do: [:e | e delete]].            	 "	success		ifTrue: 			[copyFlag not ifTrue: ["remove old method in move semantic if new exists"		srcClassOrMeta removeSelector: messageSel].internal				ifTrue: [self selectClass: srcClassOrMeta]				ifFalse: [self selectClass: dstClassOrMeta].			self setSelector: messageSel].	^ success! !!Browser methodsFor: 'drag and drop' stamp: 'alain.plantec 2/6/2009 16:33'!overwriteDialogHierarchyChange: hierarchyChange higher: higherFlag sourceClassName: srcClassName destinationClassName: dstClassName methodSelector: methodSelector 	| lf |	lf := Character cr asString.	^ UIManager default				confirm: 'There is a conflict.' translated, ' Overwrite' translated, (hierarchyChange							ifTrue: [higherFlag									ifTrue: [' superclass' translated]									ifFalse: [' subclass' translated]]							ifFalse: ['']) , ' method' translated, lf , dstClassName , '>>' , methodSelector , lf , 'by ' translated, (hierarchyChange							ifTrue: ['moving' translated]							ifFalse: ['copying' translated]) , ' method' translated, lf , srcClassName name , '>>' , methodSelector , ' ?'.				! !!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM 	"We are only interested in TransferMorphs as wrappers for             	informations. If their content is really interesting for us, will             	determined later in >>acceptDroppingMorph:event:."	| srcType dstType |	"only want drops on lists (not, for example, on pluggable texts)"	(destinationLM isKindOf: PluggableListMorph) ifFalse: [^ false].	srcType := transferMorph dragTransferType.	dstType := destinationLM getListSelector.	(srcType == #messageList		and: [dstType == #messageCategoryList or: [dstType == #classList]])		ifTrue: [^true].	(srcType == #classList		and: [dstType == #systemCategoryList])		ifTrue: [^true]."			[			srcLS == #messageList ifTrue: [^ dstLS == #messageList | (dstLS == #messageCategoryList) | (dstLS == #classList)].			srcLS == #classList ifTrue: [^ dstLS == #classList | (dstLS == #systemCategoryList)]]."	^ false! !!Browser methodsFor: 'initialization' stamp: 'GaryChambers 2/24/2011 12:56'!addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset	| row switchHeight divider |	row := AlignmentMorph newColumn		hResizing: #spaceFill;		vResizing: #spaceFill;		layoutInset: 0;		borderWidth: 1;		layoutPolicy: ProportionalLayout new.	switchHeight := StandardFonts buttonFont height + 12.	self 		addMorphicSwitchesTo: row 		at: (			LayoutFrame 				fractions: (0@1 corner: 1@1) 				offsets: (0@(1-(switchHeight))  corner: 0@0)		).	divider := BorderedSubpaneDividerMorph forTopEdge.	divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 0.	row 		addMorph: divider		fullFrame: (			LayoutFrame 				fractions: (0@1 corner: 1@1) 				offsets: (0@switchHeight negated corner: 0@(1-switchHeight))		).		row 		addMorph: aListPane		fullFrame: (			LayoutFrame 				fractions: (0@0 corner: 1@1) 				offsets: (0@0 corner: 0@(switchHeight negated))		).		window 		addMorph: row		fullFrame: (			LayoutFrame 				fractions: nominalFractions 				offsets: (0@verticalOffset corner: 0@0)		).		row on: #mouseEnter send: #paneTransition: to: window.	row on: #mouseLeave send: #paneTransition: to: window.! !!Browser methodsFor: 'initialization' stamp: 'RAA 1/10/2001 11:46'!addClassAndSwitchesTo: window at: nominalFractions plus: verticalOffset	^self		addAListPane: self buildMorphicClassList 		to: window 		at: nominalFractions 		plus: verticalOffset! !!Browser methodsFor: 'initialization' stamp: 'rr 6/21/2005 13:24'!addMorphicSwitchesTo: window at: aLayoutFrame	window 		addMorph: self buildMorphicSwitches		fullFrame: aLayoutFrame.! !!Browser methodsFor: 'initialization' stamp: 'rww 8/18/2002 09:31'!browseSelectionInPlace	"In place code - incomplete""	self systemCategoryListIndex: 		(self systemCategoryList indexOf: self selectedClass category).	self classListIndex: (self classList indexOf: self selectedClass name)"	self spawnHierarchy.! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!buildMorphicClassList	| myClassList |	(myClassList := PluggableListMorph new) 			on: self list: #classList			selected: #classListIndex changeSelected: #classListIndex:			menu: #classListMenu:shifted: keystroke: #classListKey:from:.	myClassList borderWidth: 0.	myClassList enableDragNDrop: true.	myClassList doubleClickSelector: #browseSelectionInPlace.	"For doubleClick to work best disable autoDeselect"	myClassList autoDeselect: false .	^myClassList! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!buildMorphicMessageCatList	| myMessageCatList |	(myMessageCatList := PluggableMessageCategoryListMorph new) 			on: self list: #messageCategoryList			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:			menu: #messageCategoryMenu: 			keystroke: #arrowKey:from: getRawListSelector: #rawMessageCategoryList.	myMessageCatList enableDragNDrop: true.	^myMessageCatList! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!buildMorphicMessageList	"Build a morphic message list, with #messageList as its list-getter"	| aListMorph |	(aListMorph := PluggableListMorph new) 			on: self list: #messageList			selected: #messageListIndex changeSelected: #messageListIndex:			menu: #messageListMenu:shifted:			keystroke: #messageListKey:from:.	aListMorph enableDragNDrop: true.	aListMorph menuTitleSelector: #messageListSelectorTitle.	^aListMorph! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/15/2009 09:36'!buildMorphicSystemCatList	| dragNDropFlag myCatList |	dragNDropFlag := true.	(myCatList := PluggableListMorph new) 			on: self list: #systemCategoryList			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:.	myCatList enableDragNDrop: dragNDropFlag.	^myCatList! !!Browser methodsFor: 'initialization' stamp: 'sw 1/13/2000 16:45'!defaultBrowserTitle	^ 'System Browser'! !!Browser methodsFor: 'initialization' stamp: 'AdrianLienhard 8/26/2009 21:07'!labelString	^self selectedClass ifNil: [ self defaultBrowserTitle ]		ifNotNil: [ self selectedClass printString ].! !!Browser methodsFor: 'initialization' stamp: 'sw 9/22/1999 17:13'!methodCategoryChanged	self changed: #messageCategoryList.	self changed: #messageList.	self changed: #annotation.	self messageListIndex: 0! !!Browser methodsFor: 'initialization' stamp: 'JuanVuletich 10/21/2010 12:51'!openAsMorphClassEditing: editString	"Create a pluggable version a Browser on just a single class."	^UIManager default openBrowser: self asMorphClassEditing: editString! !!Browser methodsFor: 'initialization' stamp: 'JuanVuletich 10/21/2010 12:50'!openAsMorphEditing: editString	"Create a pluggable version of all the morphs for a Browser in Morphic"	^UIManager default openBrowser: self asMorphEditing: editString! !!Browser methodsFor: 'initialization' stamp: 'JuanVuletich 10/21/2010 12:41'!openAsMorphMessageEditing: editString	"Create a pluggable version a Browser that shows just one message"	^UIManager default openBrowser: self asMorphMessageEditing: editString! !!Browser methodsFor: 'initialization' stamp: 'JuanVuletich 10/21/2010 12:46'!openAsMorphMsgCatEditing: editString	"Create a pluggable version a Browser on just a message category."	^UIManager default openBrowser: self asMorphMsgCatEditing: editString! !!Browser methodsFor: 'initialization' stamp: 'JuanVuletich 10/21/2010 11:52'!openAsMorphSysCatEditing: editString	"Create a pluggable version of all the views for a Browser, including views and controllers."	^UIManager default openBrowser: self  asMorphSysCatEditing: editString! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 6/10/2008 18:33'!openEditString: aString        "Create a pluggable version of all the views for a Browser, including views and controllers."         ^ self openAsMorphEditing: aString! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 6/10/2008 18:34'!openMessageCatEditString: aString        "Create a pluggable version of the views for a Browser that just shows one message category."         ^ self openAsMorphMsgCatEditing: aString! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/30/2008 10:08'!openMessageEditString: aString	"Create a pluggable version of the views for a Browser that just shows one message."	^ self openAsMorphMessageEditing: aString! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/30/2008 10:13'!openOnClassWithEditString: aString	"Create a pluggable version of all the views for a Browser, including views and controllers."	^ self openAsMorphClassEditing: aString.! !!Browser methodsFor: 'initialization' stamp: 'alain.plantec 5/30/2008 10:16'!openSystemCatEditString: aString	"Create a pluggable version of all the views for a Browser, including views and controllers.  The top list view is of the currently selected system class category--a single item list."	^ self openAsMorphSysCatEditing: aString! !!Browser methodsFor: 'initialization' stamp: 'sd 11/20/2005 21:26'!setClass: aBehavior selector: aSymbol	"Set the state of a new, uninitialized Browser."	| isMeta aClass messageCatIndex |	aBehavior ifNil: [^ self].	(aBehavior isKindOf: Metaclass)		ifTrue: [			isMeta := true.			aClass := aBehavior soleInstance]		ifFalse: [			isMeta := false.			aClass := aBehavior].	self selectCategoryForClass: aClass.	self classListIndex: (		(systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName)			indexOf: aClass name).	self metaClassIndicated: isMeta.	aSymbol ifNil: [^ self].	messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol.	self messageCategoryListIndex: (messageCatIndex > 0		ifTrue: [messageCatIndex + 1]		ifFalse: [0]).	messageCatIndex = 0 ifTrue: [^ self].	self messageListIndex: (		(aBehavior organization listAtCategoryNumber: messageCatIndex)			indexOf: aSymbol).! !!Browser methodsFor: 'initialization' stamp: 'sd 11/20/2005 21:26'!setSelector: aSymbol	"Make the receiver point at the given selector, in the currently chosen class"	| aClass messageCatIndex |	aSymbol ifNil: [^ self].	(aClass := self selectedClassOrMetaClass) ifNil: [^ self].	messageCatIndex := aClass organization numberOfCategoryOfElement: aSymbol.	self messageCategoryListIndex: messageCatIndex + 1.	messageCatIndex = 0 ifTrue: [^ self].	self messageListIndex:			((aClass organization listAtCategoryNumber: messageCatIndex)					indexOf: aSymbol)! !!Browser methodsFor: 'initialization' stamp: 'sw 11/8/1999 13:36'!systemCatSingletonKey: aChar from: aView	^ self messageListKey: aChar from: aView! !!Browser methodsFor: 'initialization' stamp: 'sd 11/20/2005 21:26'!systemOrganizer: aSystemOrganizer	"Initialize the receiver as a perspective on the system organizer, 	aSystemOrganizer. Typically there is only one--the system variable 	SystemOrganization."		contents := nil.	systemOrganizer := aSystemOrganizer.	systemCategoryListIndex := 0.	classListIndex := 0.	messageCategoryListIndex := 0.	messageListIndex := 0.	metaClassIndicated := false.	self setClassOrganizer.	self editSelection: #none.! !!Browser methodsFor: 'message category functions' stamp: 'MarcusDenker 10/28/2010 13:51'!addCategory	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"	| labels reject lines oldIndex newName |	self okToChange ifFalse: [^ self].	classListIndex = 0 ifTrue: [^ self].	labels := OrderedCollection new.	reject := Set new.	reject		addAll: self selectedClassOrMetaClass organization categories;		add: ClassOrganizer nullCategory;		add: ClassOrganizer default.	lines := OrderedCollection new.	self selectedClassOrMetaClass allSuperclasses do: [:cls | | cats |		cls = Object ifFalse: [			cats := cls organization categories reject:				 [:cat | reject includes: cat].			cats isEmpty ifFalse: [				lines add: labels size.				labels addAll: cats asSortedCollection.				reject addAll: cats ] ] ].		newName := UIManager default chooseOrRequestFrom: labels lines: lines title: 'Add Category'.	newName ifNil: [ ^self ].	newName := newName asSymbol.		oldIndex := messageCategoryListIndex.	self classOrMetaClassOrganizer		addCategory: newName		before: (messageCategoryListIndex = 0				ifTrue: [nil]				ifFalse: [self selectedMessageCategoryName]).	self changed: #messageCategoryList.	self messageCategoryListIndex:		(oldIndex = 0			ifTrue: [self classOrMetaClassOrganizer categories size + 1]			ifFalse: [oldIndex]).	self changed: #messageCategoryList. ! !!Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:47'!alphabetizeMessageCategories	classListIndex = 0 ifTrue: [^ false].	self okToChange ifFalse: [^ false].	self classOrMetaClassOrganizer sortCategories.	self clearUserEditFlag.	self editClass.	self classListIndex: classListIndex.	^ true! !!Browser methodsFor: 'message category functions'!buildMessageCategoryBrowser	"Create and schedule a message category browser for the currently 	selected message category."	self buildMessageCategoryBrowserEditString: nil! !!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!buildMessageCategoryBrowserEditString: aString 	"Create and schedule a message category browser for the currently 	selected	 message category. The initial text view contains the characters 	in aString."	"wod 6/24/1998: set newBrowser classListIndex so that it works whether the	receiver is a standard or a Hierarchy Browser."	| newBrowser |	messageCategoryListIndex ~= 0		ifTrue: 			[newBrowser := Browser new.			newBrowser systemCategoryListIndex: systemCategoryListIndex.			newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName).			newBrowser metaClassIndicated: metaClassIndicated.			newBrowser messageCategoryListIndex: messageCategoryListIndex.			newBrowser messageListIndex: messageListIndex.			self class openBrowserView: (newBrowser openMessageCatEditString: aString)				label: 'Message Category Browser (' , 						newBrowser selectedClassOrMetaClassName , ')']! !!Browser methodsFor: 'message category functions' stamp: 'sw 10/8/2001 14:10'!canShowMultipleMessageCategories	"Answer whether the receiver is capable of showing multiple message categories"	^ true! !!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!categoryOfCurrentMethod	"Determine the method category associated with the receiver at the current moment, or nil if none"	| aCategory |	^ super categoryOfCurrentMethod ifNil:		[(aCategory := self messageCategoryListSelection) == ClassOrganizer allCategory					ifTrue:						[nil]					ifFalse:						[aCategory]]! !!Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:56'!changeMessageCategories: aString 	"The characters in aString represent an edited version of the the message 	categories for the selected class. Update this information in the system 	and inform any dependents that the categories have been changed. This 	message is invoked because the user had issued the categories command 	and edited the message categories. Then the user issued the accept 	command."	self classOrMetaClassOrganizer changeFromString: aString.	self clearUserEditFlag.	self editClass.	self classListIndex: classListIndex.	^ true! !!Browser methodsFor: 'message category functions' stamp: 'nk 2/14/2004 15:06'!editMessageCategories	"Indicate to the receiver and its dependents that the message categories of 	the selected class have been changed."	self okToChange ifFalse: [^ self].	classListIndex ~= 0		ifTrue: 			[self messageCategoryListIndex: 0.			self editSelection: #editMessageCategories.			self changed: #editMessageCategories.			self contentsChanged]! !!Browser methodsFor: 'message category functions' stamp: 'tk 4/2/98 13:53'!fileOutMessageCategories	"Print a description of the selected message category of the selected class 	onto an external file."Cursor write showWhile:	[messageCategoryListIndex ~= 0		ifTrue: 			[self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName]]! !!Browser methodsFor: 'message category functions' stamp: 'tbn 7/6/2010 16:12'!messageCategoryMenu: aMenu	^ aMenu labels:'BrowseFileOutReorganizeAlphabetizeRemove empty categoriesCategorize all uncategorizedNew Category...Rename...Remove'		lines: #(3 8)		selections:		#(buildMessageCategoryBrowser fileOutMessageCategories		editMessageCategories alphabetizeMessageCategories removeEmptyCategories		categorizeAllUncategorizedMethods addCategory renameCategory removeMessageCategory)! !!Browser methodsFor: 'message category functions' stamp: 'nk 4/23/2004 09:18'!removeEmptyCategories	self okToChange ifFalse: [^ self].	self selectedClassOrMetaClass organization removeEmptyCategories.	self changed: #messageCategoryList! !!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!removeMessageCategory	"If a message category is selected, create a Confirmer so the user can 	verify that the currently selected message category should be removed 	from the system. If so, remove it."	| messageCategoryName |	messageCategoryListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	messageCategoryName := self selectedMessageCategoryName.	(self messageList size = 0		or: [self confirm: 'Are you sure you want toremove this method category and all its methods?'])		ifTrue: 			[self selectedClassOrMetaClass removeCategory: messageCategoryName.			self messageCategoryListIndex: 0.			self changed: #classSelectionChanged].	self changed: #messageCategoryList.! !!Browser methodsFor: 'message category functions' stamp: 'DamienCassou 9/29/2009 09:05'!renameCategory	"Prompt for a new category name and add it before the	current selection, or at the end if no current selection"	| oldIndex oldName newName |	classListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	(oldIndex := messageCategoryListIndex) = 0 ifTrue: [^ self].	oldName := self selectedMessageCategoryName.	newName := self		request: 'Please type new category name'		initialAnswer: oldName.	newName isEmptyOrNil		ifTrue: [^ self]		ifFalse: [newName := newName asSymbol].	newName = oldName ifTrue: [^ self].	self classOrMetaClassOrganizer		renameCategory: oldName		toBe: newName.	self classListIndex: classListIndex.	self messageCategoryListIndex: oldIndex.	self changed: #messageCategoryList.! !!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!showHomeCategory	"Show the home category of the selected method.  This is only really useful if one is in a tool that supports the showing of categories.  Thus, it's good in browsers and hierarchy browsers but not in message-list browsers"	| aSelector |	self okToChange ifTrue:		[(aSelector := self selectedMessageName) ifNotNil:			[self selectOriginalCategoryForCurrentMethod.			self selectedMessageName: aSelector]]! !!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!categorizeAllUncategorizedMethods	"Categorize methods by looking in parent classes for a method category."	| organizer organizers |	organizer := self classOrMetaClassOrganizer.	organizers := self selectedClassOrMetaClass withAllSuperclasses collect: [:ea | ea organization].	(organizer listAtCategoryNamed: ClassOrganizer default) do: [:sel | | found |		found := (organizers collect: [ :org | org categoryOfElement: sel])			detect: [:ea | ea ~= ClassOrganizer default and: [ ea ~= nil]]			ifNone: [].		found ifNotNil: [organizer classify: sel under: found]].	self changed: #messageCategoryList! !!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!messageCatListSingleton	| name |	name := self selectedMessageCategoryName.	^ name ifNil: [Array new]		ifNotNil: [Array with: name]! !!Browser methodsFor: 'message category list' stamp: 'ccn 3/22/1999 17:56'!messageCategoryList	"Answer the selected category of messages."	classListIndex = 0		ifTrue: [^ Array new]		ifFalse: [^ (Array with: ClassOrganizer allCategory), self classOrMetaClassOrganizer categories]! !!Browser methodsFor: 'message category list'!messageCategoryListIndex	"Answer the index of the selected message category."	^messageCategoryListIndex! !!Browser methodsFor: 'message category list' stamp: 'StephaneDucasse 2/14/2011 12:49'!messageCategoryListIndex: anInteger	"Set the selected message category to be the one indexed by anInteger."	messageCategoryListIndex := anInteger.	messageListIndex := 0.	self changed: #messageCategorySelectionChanged.	self changed: #messageCategoryListIndex. "update my selection"	self changed: #messageList.	self editSelection: (anInteger > 0		ifTrue: [self beStyled. 				#newMessage]		ifFalse: [self classListIndex > 0			ifTrue: [self beUnStyled.					#editClass]			ifFalse: [self beUnStyled.					#newClass]]).	contents := nil.	self contentsChanged.! !!Browser methodsFor: 'message category list' stamp: 'ccn 3/24/1999 11:02'!messageCategoryListSelection	"Return the selected category name or nil."	^ ((self messageCategoryList size = 0 		or: [self messageCategoryListIndex = 0]) 		or: [self messageCategoryList size < self messageCategoryListIndex])			ifTrue: [nil]			ifFalse: [self messageCategoryList at: (self messageCategoryListIndex max: 1)]! !!Browser methodsFor: 'message category list' stamp: 'sw 10/16/1999 22:56'!rawMessageCategoryList	^ classListIndex = 0		ifTrue: [Array new]		ifFalse: [self classOrMetaClassOrganizer categories]! !!Browser methodsFor: 'message category list' stamp: 'nice 1/5/2010 15:59'!recategorizeMethodSelector: sel 	"Categorize method named sel by looking in parent classes for a 	method category. 	Answer true if recategorized."		self selectedClassOrMetaClass allSuperclasses		do: [:ea | | thisCat | 			thisCat := ea organization categoryOfElement: sel.			(thisCat ~= ClassOrganizer default					and: [thisCat notNil])				ifTrue: [self classOrMetaClassOrganizer classify: sel under: thisCat.					self changed: #messageCategoryList.					^ true]].	^ false! !!Browser methodsFor: 'message category list' stamp: 'nk 6/13/2004 06:20'!selectMessageCategoryNamed: aSymbol 	"Given aSymbol, select the category with that name.  Do nothing if 	aSymbol doesn't exist."	self messageCategoryListIndex: (self messageCategoryList indexOf: aSymbol ifAbsent: [ 1])! !!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!selectOriginalCategoryForCurrentMethod	"private - Select the message category for the current method. 	 	 Note:  This should only be called when somebody tries to save  	 a method that they are modifying while ALL is selected. 	 	 Returns: true on success, false on failure."	| aSymbol selectorName |	aSymbol := self categoryOfCurrentMethod.	selectorName := self selectedMessageName.	(aSymbol notNil and: [aSymbol ~= ClassOrganizer allCategory])		ifTrue: 			[messageCategoryListIndex := (self messageCategoryList indexOf: aSymbol).			messageListIndex := (self messageList indexOf: selectorName).			self changed: #messageCategorySelectionChanged.			self changed: #messageCategoryListIndex.	"update my selection"			self changed: #messageList.			self changed: #messageListIndex.			^ true].	^ false! !!Browser methodsFor: 'message category list'!selectedMessageCategoryName	"Answer the name of the selected message category, if any. Answer nil 	otherwise."	messageCategoryListIndex = 0 ifTrue: [^nil].	^self messageCategoryList at: messageCategoryListIndex! !!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!setOriginalCategoryIndexForCurrentMethod	"private - Set the message category index for the currently selected method. 	 	 Note:  This should only be called when somebody tries to save  	 a method that they are modifying while ALL is selected."	messageCategoryListIndex := self messageCategoryList indexOf: self categoryOfCurrentMethod	! !!Browser methodsFor: 'message functions' stamp: 'sw 1/11/2001 07:22'!addExtraShiftedItemsTo: aMenu	"The shifted selector-list menu is being built; some menu items are appropriate only for certain kinds of browsers, and this gives a hook for them to be added as approrpiate.  If any is added here, a line should be added first -- browse reimplementors of this message for examples."! !!Browser methodsFor: 'message functions' stamp: 'MarronyNeris 9/23/2011 11:30'!defineMessageFrom: aString notifying: aController	"Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under  the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise."	| selectedMessageName selector category oldMessageList |	selectedMessageName := self selectedMessageName.	oldMessageList := self messageList.	contents := nil.	selector := self selectedClassOrMetaClass				compile: aString				classified: (category := self selectedMessageCategoryName)				notifying: aController.	selector == nil ifTrue: [^ nil].	contents := aString copy.	selector ~~ selectedMessageName		ifTrue: 			[category = ClassOrganizer nullCategory				ifTrue: [self changed: #classSelectionChanged.						self changed: #classList.						self messageCategoryListIndex: 1].			self setClassOrganizer.  "In case organization not cached"			(oldMessageList includes: selector)				ifFalse: [self changed: #messageList].			self messageListIndex: (self messageList indexOf: selector)].	self fileOutClass.	^ selector! !!Browser methodsFor: 'message functions' stamp: 'al 4/24/2004 12:48'!inspectInstances	"Inspect all instances of the selected class.  1/26/96 sw"	| myClass |	((myClass := self selectedClassOrMetaClass) isNil or: [myClass isTrait])		ifFalse: [myClass theNonMetaClass inspectAllInstances]! !!Browser methodsFor: 'message functions' stamp: 'al 4/24/2004 12:48'!inspectSubInstances	"Inspect all instances of the selected class and all its subclasses  1/26/96 sw"	| aClass |	((aClass := self selectedClassOrMetaClass) isNil or: [aClass isTrait])		ifFalse: [			aClass := aClass theNonMetaClass.			aClass inspectSubInstances].! !!Browser methodsFor: 'message functions' stamp: 'tbn 7/6/2010 16:13'!messageListMenu: aMenu shifted: shifted 	"Answer the message-list menu"	shifted		ifTrue: [^ self shiftedMessageListMenu: aMenu].	aMenu addList: #(			('What to show...'			offerWhatToShowMenu)			('Toggle break on entry'		toggleBreakOnEntry)			-			('Browse full (b)' 			browseMethodFull)			('Browse hierarchy (h)'			classHierarchy)			('Browse method (O)'			openSingleMessageBrowser)			('Browse protocol (p)'			browseFullProtocol)			-			('FileOut'				fileOutMessage)			-			('Senders of... (n)'			browseSendersOfMessages)			('Implementors of... (m)'		browseMessages)			('Inheritance (i)'			methodHierarchy)			('Versions (v)'				browseVersions)			-			('Inst var refs...'			browseInstVarRefs)			('Inst var defs...'			browseInstVarDefs)			('Class var refs...'			browseClassVarRefs)			('Class variables'			browseClassVariables)			('Class refs (N)'			browseClassRefs)			-			('Remove method (x)'			removeMessage)			-			('More...'				shiftedYellowButtonActivity)).	^ aMenu! !!Browser methodsFor: 'message functions' stamp: 'AlainPlantec 1/7/2010 21:40'!removeMessage	"If a message is selected, create a Confirmer so the user can verify that  	the currently selected message should be removed from the system. If 	so, remove it. "	| messageName confirmation |	messageListIndex = 0		ifTrue: [^ self].	self okToChange		ifFalse: [^ self].	messageName := self selectedMessageName.	confirmation := self systemNavigation   confirmRemovalOf: messageName on: self selectedClassOrMetaClass.	confirmation == 3		ifTrue: [^ self].	(self selectedClassOrMetaClass includesLocalSelector: messageName)		ifTrue: [self selectedClassOrMetaClass removeSelector: messageName]		ifFalse: [self removeNonLocalSelector: messageName].	self messageListIndex: 0.	self changed: #messageList.	self setClassOrganizer.	"In case organization not cached"	confirmation == 2		ifTrue: [self systemNavigation browseAllCallsOn: messageName]! !!Browser methodsFor: 'message functions' stamp: 'tk 4/2/98 17:03'!removeMessageFromBrowser	"Our list speaks the truth and can't have arbitrary things removed"	^ self changed: #flash! !!Browser methodsFor: 'message functions' stamp: 'tbn 7/29/2010 22:00'!shiftedMessageListMenu: aMenu	"Fill aMenu with the items appropriate when the shift key is held down"	aMenu addStayUpItem.	aMenu addList: #(		('Toggle diffing (D)'						toggleDiffing)		('Implementors of sent messages'			browseAllMessages)		-		('Local senders of...'						browseLocalSendersOfMessages)		('Local implementors of...'				browseLocalImplementors)		-		('Spawn sub-protocol'					spawnProtocol)		('Spawn full protocol'					spawnFullProtocol)		-		('Sample instance'						makeSampleInstance)		('Inspect instances'						inspectInstances)		('Inspect subinstances'					inspectSubInstances)).	self addExtraShiftedItemsTo: aMenu.	aMenu addList: #(		-		('Change category...'					changeCategory)).	self canShowMultipleMessageCategories ifTrue: [aMenu addList:		 #(('Show category (C)'						showHomeCategory))].	aMenu addList: #(		-		('Change sets with this method'			findMethodInChangeSets)		('Revert to previous version'				revertToPreviousVersion)		('Remove from current change set'		removeFromCurrentChanges)		('Revert & remove from changes'		revertAndForget)		('Add to current change set'				adoptMessageInCurrentChangeset)		('Copy up or copy down...'				copyUpOrCopyDown)		-		('More...' 								unshiftedYellowButtonActivity)).	^ aMenu! !!Browser methodsFor: 'message list' stamp: 'adrian-lienhard 5/18/2009 21:10'!messageList	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."	| sel |	(sel := self messageCategoryListSelection) ifNil: [		^ self classOrMetaClassOrganizer			ifNil: [Array new]			ifNotNil: [self classOrMetaClassOrganizer allMethodSelectors]	].	^ sel = ClassOrganizer allCategory ifTrue:  [		self classOrMetaClassOrganizer			ifNil: [Array new]			ifNotNil: [self classOrMetaClassOrganizer allMethodSelectors]]		ifFalse: [			(self classOrMetaClassOrganizer listAtCategoryNumber: messageCategoryListIndex - 1)				ifNil: [messageCategoryListIndex := 0.  Array new]]! !!Browser methodsFor: 'message list'!messageListIndex	"Answer the index of the selected message selector into the currently 	selected message category."	^messageListIndex! !!Browser methodsFor: 'message list' stamp: 'StephaneDucasse 2/14/2011 12:50'!messageListIndex: anInteger	"Set the selected message selector to be the one indexed by anInteger."	messageListIndex := anInteger.	self beStyled.	self editSelection: (anInteger > 0		ifTrue: [#editMessage]		ifFalse: [self messageCategoryListIndex > 0			ifTrue: [#newMessage]			ifFalse: [self classListIndex > 0				ifTrue: [#editClass]				ifFalse: [#newClass]]]).	contents := nil.	self changed: #messageListIndex. "update my selection"	self contentsChanged.	self decorateButtons.! !!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!messageListSingleton	| name |	name := self selectedMessageName.	^ name ifNil: [Array new]		ifNotNil: [Array with: name]! !!Browser methodsFor: 'message list' stamp: 'sw 12/1/2000 11:17'!reformulateList	"If the receiver has a way of reformulating its message list, here is a chance for it to do so"	super reformulateList.	self messageListIndex: 0! !!Browser methodsFor: 'message list' stamp: 'md 2/20/2006 15:01'!selectedMessage	"Answer a copy of the source code for the selected message."	| class selector method |	contents == nil ifFalse: [^ contents copy].	self showingDecompile ifTrue:		[^ self decompiledSourceIntoContents].	class := self selectedClassOrMetaClass.	selector := self selectedMessageName.	method := class compiledMethodAt: selector ifAbsent: [^ ''].	"method deleted while in another project"	currentCompiledMethod := method.	^ contents := (self showingDocumentation		ifFalse: [ self sourceStringPrettifiedAndDiffed ]		ifTrue: [ self commentContents ])			copy asText makeSelectorBoldIn: class! !!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!selectedMessageName	"Answer the message selector of the currently selected message, if any. 	Answer nil otherwise."	| aList |	messageListIndex = 0 ifTrue: [^ nil].	^ (aList := self messageList) size >= messageListIndex		ifTrue:			[aList at: messageListIndex]		ifFalse:			[nil]! !!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!selectedMessageName: aSelector	"Make the given selector be the selected message name"	| anIndex |	anIndex := self messageList indexOf: aSelector.	anIndex > 0 ifTrue:		[self messageListIndex: anIndex]! !!Browser methodsFor: 'metaclass' stamp: 'di 1/14/98 12:25'!classCommentIndicated	"Answer true iff we're viewing the class comment."	^ editSelection == #editComment ! !!Browser methodsFor: 'metaclass' stamp: 'mir 9/25/2008 14:56'!classMessagesIndicated	"Answer whether the messages to be presented should come from the metaclass."	^ self metaClassIndicated and: [self classCommentIndicated not]! !!Browser methodsFor: 'metaclass'!classOrMetaClassOrganizer	"Answer the class organizer for the metaclass or class, depending on 	which (instance or class) is indicated."	self metaClassIndicated		ifTrue: [^metaClassOrganizer]		ifFalse: [^classOrganizer]! !!Browser methodsFor: 'metaclass'!indicateClassMessages	"Indicate that the message selection should come from the metaclass 	messages."	self metaClassIndicated: true! !!Browser methodsFor: 'metaclass'!indicateInstanceMessages	"Indicate that the message selection should come from the class (instance) 	messages."	self metaClassIndicated: false! !!Browser methodsFor: 'metaclass' stamp: 'di 1/14/98 13:20'!instanceMessagesIndicated	"Answer whether the messages to be presented should come from the 	class."	^metaClassIndicated not and: [self classCommentIndicated not]! !!Browser methodsFor: 'metaclass' stamp: 'sr 6/21/2000 17:23'!metaClassIndicated	"Answer the boolean flag that indicates which of the method dictionaries, 	class or metaclass."	^ metaClassIndicated! !!Browser methodsFor: 'metaclass' stamp: 'sd 11/20/2005 21:26'!metaClassIndicated: trueOrFalse 	"Indicate whether browsing instance or class messages."	metaClassIndicated := trueOrFalse.	self setClassOrganizer.	systemCategoryListIndex > 0 ifTrue:		[self editSelection: (classListIndex = 0			ifTrue: [metaClassIndicated				ifTrue: [#none]				ifFalse: [#newClass]]			ifFalse: [#editClass])].	messageCategoryListIndex := 0.	messageListIndex := 0.	contents := nil.	self changed: #classSelectionChanged.	self changed: #messageCategoryList.	self changed: #messageList.	self changed: #contents.	self changed: #annotation.	self decorateButtons! !!Browser methodsFor: 'metaclass' stamp: 'al 4/24/2004 11:47'!selectedClassOrMetaClass	"Answer the selected class/trait or metaclass/classTrait."	| cls |	^self metaClassIndicated		ifTrue: [(cls := self selectedClass) ifNil: [nil] ifNotNil: [cls classSide]]		ifFalse: [self selectedClass]! !!Browser methodsFor: 'metaclass'!selectedClassOrMetaClassName	"Answer the selected class name or metaclass name."	^self selectedClassOrMetaClass name! !!Browser methodsFor: 'metaclass' stamp: 'md 2/18/2006 16:31'!setClassOrganizer	"Install whatever organization is appropriate"	| theClass |	classOrganizer := nil.	metaClassOrganizer := nil.	classListIndex = 0 ifTrue: [^ self].	theClass := self selectedClass ifNil: [ ^self ].	classOrganizer := theClass organization.	metaClassOrganizer := theClass classSide organization.! !!Browser methodsFor: 'system category functions' stamp: 'DamienCassou 9/29/2009 09:04'!addSystemCategory	"Prompt for a new category name and add it before the	current selection, or at the end if no current selection"	| oldIndex newName |	self okToChange ifFalse: [^ self].	oldIndex := systemCategoryListIndex.	newName := self		request: 'Please type new category name'		initialAnswer: 'Category-Name'.	newName isEmptyOrNil		ifTrue: [^ self]		ifFalse: [newName := newName asSymbol].	systemOrganizer		addCategory: newName		before: (systemCategoryListIndex = 0				ifTrue: [nil]				ifFalse: [self selectedSystemCategoryName]).	self systemCategoryListIndex:		(oldIndex = 0			ifTrue: [self systemCategoryList size]			ifFalse: [oldIndex]).	self changed: #systemCategoryList.! !!Browser methodsFor: 'system category functions' stamp: 'brp 8/4/2003 21:38'!alphabetizeSystemCategories	self okToChange ifFalse: [^ false].	systemOrganizer sortCategories.	self systemCategoryListIndex: 0.	self changed: #systemCategoryList.! !!Browser methodsFor: 'system category functions'!buildSystemCategoryBrowser	"Create and schedule a new system category browser."	self buildSystemCategoryBrowserEditString: nil! !!Browser methodsFor: 'system category functions' stamp: 'sd 11/20/2005 21:26'!buildSystemCategoryBrowserEditString: aString 	"Create and schedule a new system category browser with initial textual 	contents set to aString."	| newBrowser |	systemCategoryListIndex > 0		ifTrue: 			[newBrowser := self class new.			newBrowser systemCategoryListIndex: systemCategoryListIndex.			newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName.			self class openBrowserView: (newBrowser openSystemCatEditString: aString)				label: 'Classes in category ', newBrowser selectedSystemCategoryName]! !!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:21'!changeSystemCategories: aString 	"Update the class categories by parsing the argument aString."	systemOrganizer changeFromString: aString.	self changed: #systemCategoryList.	^ true! !!Browser methodsFor: 'system category functions' stamp: 'tk 4/2/98 13:43'!classNotFound	self changed: #flash.! !!Browser methodsFor: 'system category functions' stamp: 'nk 2/14/2004 15:09'!editSystemCategories	"Retrieve the description of the class categories of the system organizer."	self okToChange ifFalse: [^ self].	self systemCategoryListIndex: 0.	self editSelection: #editSystemCategories.	self changed: #editSystemCategories.	self contentsChanged! !!Browser methodsFor: 'system category functions' stamp: 'tk 3/31/98 07:52'!fileOutSystemCategory	"Print a description of each class in the selected category onto a file 	whose name is the category name followed by .st."	systemCategoryListIndex ~= 0		ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName]! !!Browser methodsFor: 'system category functions' stamp: 'AlainPlantec 4/15/2010 10:43'!findClass	"Search for a class from a pattern or from the recent list"	| pattern foundClassOrTrait recentList |	self okToChange ifFalse: [^ self classNotFound].	recentList := RecentClasses select: [ :n | Smalltalk globals includesKey: n ].	recentList size == 0		ifTrue: [pattern := UIManager default request: 'Class name or fragment?']		ifFalse: [pattern := UIManager default 				enterOrRequestFrom: recentList 				lines: #() 				title: 'Class name or fragment?'].	pattern isEmptyOrNil ifTrue: [^ self classNotFound].	foundClassOrTrait := SystemNavigation default classFromPattern: pattern withCaption: ''.	foundClassOrTrait ifNil: [^ self classNotFound]. 	self selectCategoryForClass: foundClassOrTrait.	self selectClass: foundClassOrTrait! !!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:55'!removeSystemCategory	"If a class category is selected, create a Confirmer so the user can 	verify that the currently selected class category and all of its classes 	should be removed from the system. If so, remove it."	systemCategoryListIndex = 0 ifTrue: [^ self].	self okToChange ifFalse: [^ self].	(self classList size = 0		or: [self confirm: 'Are you sure you want toremove this system category and all its classes?'])		ifTrue: 		[systemOrganizer removeSystemCategory: self selectedSystemCategoryName.		self systemCategoryListIndex: 0.		self changed: #systemCategoryList]! !!Browser methodsFor: 'system category functions' stamp: 'DamienCassou 9/29/2009 09:05'!renameSystemCategory	"Prompt for a new category name and add it before the	current selection, or at the end if no current selection"	| oldIndex oldName newName |	(oldIndex := systemCategoryListIndex) = 0		ifTrue: [^ self].  "no selection"	self okToChange ifFalse: [^ self].	oldName := self selectedSystemCategoryName.	newName := self		request: 'Please type new category name'		initialAnswer: oldName.	newName isEmptyOrNil 		ifTrue: [^ self]		ifFalse: [newName := newName asSymbol].	oldName = newName ifTrue: [^ self].	systemOrganizer		renameCategory: oldName		toBe: newName.	self systemCategoryListIndex: oldIndex.	self changed: #systemCategoryList.! !!Browser methodsFor: 'system category functions' stamp: 'marcus.denker 10/20/2008 21:22'!systemCatSingletonMenu: aMenu	^ aMenu labels:'browsefileOutupdaterename...remove' 	lines: #(2 4)	selections:		#(buildSystemCategoryBrowser		fileOutSystemCategory updateSystemCategories		renameSystemCategory removeSystemCategory)! !!Browser methodsFor: 'system category functions' stamp: 'tbn 7/6/2010 16:09'!systemCategoryMenu: aMenu			^ aMenu labels:'Find Class... (f)BrowseFileOutReorganizeAlphabetizeUpdateAdd Category...Rename...Remove' 	lines: #(2 4 6 8)	selections:		#(findClass buildSystemCategoryBrowser		fileOutSystemCategory		editSystemCategories alphabetizeSystemCategories updateSystemCategories		addSystemCategory renameSystemCategory removeSystemCategory )! !!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:17'!updateSystemCategories	"The class categories were changed in another browser. The receiver must 	reorganize its lists based on these changes."	self okToChange ifFalse: [^ self].	self changed: #systemCategoryList! !!Browser methodsFor: 'system category list' stamp: 'tk 5/4/1998 15:46'!indexIsOne	"When used as a singleton list, index is always one"	^ 1! !!Browser methodsFor: 'system category list' stamp: 'tk 5/4/1998 15:46'!indexIsOne: value	"When used as a singleton list, can't change it"	^ self! !!Browser methodsFor: 'system category list' stamp: 'stp 01/13/2000 12:25'!selectCategoryForClass: theClass	self systemCategoryListIndex: (self systemCategoryList indexOf: theClass category)! !!Browser methodsFor: 'system category list' stamp: 'md 3/3/2006 11:02'!selectedEnvironment	"Answer the name of the selected system category or nil."	systemCategoryListIndex = 0 ifTrue: [^nil].	^ Smalltalk! !!Browser methodsFor: 'system category list'!selectedSystemCategoryName	"Answer the name of the selected system category or nil."	systemCategoryListIndex = 0 ifTrue: [^nil].	^self systemCategoryList at: systemCategoryListIndex! !!Browser methodsFor: 'system category list'!systemCategoryList	"Answer the class categories modelled by the receiver."	^systemOrganizer categories! !!Browser methodsFor: 'system category list'!systemCategoryListIndex	"Answer the index of the selected class category."	^systemCategoryListIndex! !!Browser methodsFor: 'system category list' stamp: 'StephaneDucasse 2/14/2011 12:51'!systemCategoryListIndex: anInteger 	"Set the selected system category index to be anInteger. Update all other 	selections to be deselected."	self beStyled.	systemCategoryListIndex := anInteger.	classListIndex := 0.	messageCategoryListIndex := 0.	messageListIndex := 0.	self editSelection: ( anInteger = 0 ifTrue: [#none] ifFalse: [#newClass]).	metaClassIndicated := false.	self setClassOrganizer.	contents := nil.	self changed: #systemCategorySelectionChanged.	self changed: #systemCategoryListIndex.	"update my selection"	self changed: #classList.	self changed: #messageCategoryList.	self changed: #messageList.	self changed: #relabel.	self contentsChanged! !!Browser methodsFor: 'system category list' stamp: 'sd 11/20/2005 21:26'!systemCategorySingleton	| cat |	cat := self selectedSystemCategoryName.	^ cat ifNil: [Array new]		ifNotNil: [Array with: cat]! !!Browser methodsFor: 'toolbuilder' stamp: 'StephaneDucasse 2/14/2011 12:59'!beStyled	self textMorph ifNotNilDo: [:it | it beStyled].! !!Browser methodsFor: 'toolbuilder' stamp: 'StephaneDucasse 2/14/2011 12:59'!beUnStyled	self textMorph ifNotNilDo: [:it | it beUnStyled].! !!Browser methodsFor: 'toolbuilder' stamp: 'tbn 7/6/2010 16:10'!buildWith: builder	"Create the ui for the browser"	| windowSpec listSpec textSpec buttonSpec panelSpec max |	windowSpec := builder pluggableWindowSpec new.	windowSpec model: self.	windowSpec label: 'System Browser'.	windowSpec children: OrderedCollection new.	max := self wantsOptionalButtons ifTrue:[0.43] ifFalse:[0.5].	listSpec := builder pluggableListSpec new.	listSpec 		model: self;		list: #systemCategoryList; 		getIndex: #systemCategoryListIndex; 		setIndex: #systemCategoryListIndex:; 		menu: #systemCategoryMenu:; 		keyPress: #systemCatListKey:from:;		frame: (0@0 corner: 0.25@max).	windowSpec children add: listSpec.	listSpec := builder pluggableListSpec new.	listSpec 		model: self;		list: #classList; 		getIndex: #classListIndex; 		setIndex: #classListIndex:; 		menu: #classListMenu:; 		keyPress: #classListKey:from:;		frame: (0.25@0 corner: 0.5@(max-0.1)).	windowSpec children add: listSpec.	panelSpec := builder pluggablePanelSpec new.	panelSpec frame: (0.25@(max-0.1) corner: 0.5@max).	panelSpec children: OrderedCollection new.	windowSpec children addLast: panelSpec.		buttonSpec := builder pluggableButtonSpec new.		buttonSpec 			model: self;			label: 'Instance'; 			state: #instanceMessagesIndicated; 			action: #indicateInstanceMessages;			frame: (0@0 corner: 0.4@1).		panelSpec children addLast: buttonSpec.		buttonSpec := builder pluggableButtonSpec new.		buttonSpec 			model: self;			label: '?'; 			state: #classCommentIndicated; 			action: #plusButtonHit;			frame: (0.4@0 corner: 0.6@1).		panelSpec children addLast: buttonSpec.		buttonSpec := builder pluggableButtonSpec new.		buttonSpec 			model: self;			label: 'Class'; 			state: #classMessagesIndicated; 			action: #indicateClassMessages;			frame: (0.6@0 corner: 1@1).		panelSpec children addLast: buttonSpec.	listSpec := builder pluggableListSpec new.	listSpec 		model: self;		list: #messageCategoryList; 		getIndex: #messageCategoryListIndex; 		setIndex: #messageCategoryListIndex:; 		menu: #messageCategoryMenu:; 		keyPress: #arrowKey:from:;		frame: (0.5@0 corner: 0.75@max).	windowSpec children add: listSpec.	listSpec := builder pluggableListSpec new.	listSpec 		model: self;		list: #messageList; 		getIndex: #messageListIndex; 		setIndex: #messageListIndex:; 		menu: #messageListMenu:shifted:; 		keyPress: #messageListKey:from:;		frame: (0.75@0 corner: 1@max).	windowSpec children add: listSpec.	self wantsOptionalButtons ifTrue:[		panelSpec := self buildOptionalButtonsWith: builder.		panelSpec frame: (0@0.43 corner: 1@0.5).		windowSpec children add: panelSpec.	].	textSpec := builder pluggableTextSpec new.	textSpec 		model: self;		getText: #contents; 		setText: #contents:notifying:; 		selection: #contentsSelection; 		menu: #codePaneMenu:shifted:;		frame: (0@0.5corner: 1@1).	windowSpec children add: textSpec.	^builder build: windowSpec! !!Browser methodsFor: 'traits' stamp: 'lr 3/14/2010 21:13'!addTrait	| input trait |	input := UIManager default request: 'add trait'.	input isEmptyOrNil		ifFalse: [ 			trait := Smalltalk globals classNamed: input.			(trait isNil or: [ trait isTrait not ])				ifTrue: [ ^ self inform: 'Input invalid. ' , input , ' does not exist or is not a trait' ].			self selectedClass addToComposition: trait.			self contentsChanged ]! !!Browser methodsFor: 'traits' stamp: 'md 3/3/2006 10:58'!defineTrait: defString notifying: aController  	| defTokens keywdIx envt oldTrait newTraitName trait |	oldTrait := self selectedClassOrMetaClass.	defTokens := defString findTokens: Character separators.	keywdIx := defTokens findFirst: [:x | x = 'category'].	envt := self selectedEnvironment.	keywdIx := defTokens findFirst: [:x | x = 'named:'].	newTraitName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'.	((oldTrait isNil or: [oldTrait baseTrait name asString ~= newTraitName])		and: [envt includesKey: newTraitName asSymbol]) ifTrue:			["Attempting to define new class/trait over existing one when				not looking at the original one in this browser..."			(self confirm: ((newTraitName , ' is an existing class/trait in this system.Redefining it might cause serious problems.Is this really what you want to do?') asText makeBoldFrom: 1 to: newTraitName size))				ifFalse: [^ false]].	trait := Compiler evaluate: defString notifying: aController logged: true.	^(trait isKindOf: TraitBehavior)		ifTrue: [			self changed: #classList.			self classListIndex: (self classList indexOf: trait baseTrait name).			self clearUserEditFlag; editClass.			true]		ifFalse: [ false ]! !!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:48'!newClass	(self selectedClassOrMetaClass notNil and: 		[self selectedClassOrMetaClass isTrait]) ifTrue: [self classListIndex: 0].	self editClass.	editSelection := #newClass.	self contentsChanged! !!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:48'!newTrait	self classListIndex: 0.	self editClass.	editSelection := #newTrait.	self contentsChanged! !!Browser methodsFor: 'traits' stamp: 'jannik.laval 5/1/2010 16:00'!removeNonLocalSelector: aSymbol	| traits isAlias |	traits := self selectedClassOrMetaClass traitsProvidingSelector: aSymbol.	isAlias := self selectedClassOrMetaClass isLocalAliasSelector: aSymbol.	isAlias		ifTrue: [			[traits size = 1] assert.			self selectedClassOrMetaClass removeAlias: aSymbol of: traits first]		ifFalse: [			traits do: [:each |				self selectedClassOrMetaClass addExclusionOf: aSymbol to: each ]]	! !!Browser methodsFor: 'user interface' stamp: 'hpt 9/30/2004 20:51'!addModelItemsToWindowMenu: aMenu	"Add model-related items to the window menu"	super addModelItemsToWindowMenu: aMenu.	SystemBrowser addRegistryMenuItemsTo: aMenu inAccountOf: self.! !"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!Browser class	instanceVariableNames: ''!!Browser class methodsFor: '*Polymorph-TaskbarIcons' stamp: 'gvc 5/18/2007 10:32'!taskbarIcon	"Answer the icon for the receiver in a task bar."	^UITheme current smallSystemBrowserIcon! !!Browser class methodsFor: 'cleanup' stamp: 'StephaneDucasse 3/9/2010 16:19'!cleanUp	"Flush caches"	self initialize.! !!Browser class methodsFor: 'initialization' stamp: 'AlainPlantec 10/17/2009 18:02'!initialize	"Browser initialize"	RecentClasses := OrderedCollection new.	self registerInAppRegistry	! !!Browser class methodsFor: 'initialization' stamp: 'hpt 8/5/2004 19:41'!registerInAppRegistry	"Register the receiver in the SystemBrowser AppRegistry"	SystemBrowser register: self.! !!Browser class methodsFor: 'initialization' stamp: 'AlainPlantec 10/17/2009 16:42'!unload	"Unload the receiver from global registries"	SystemBrowser unregister: self.! !!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:27'!fullOnClass: aClass 	"Open a new full browser set to class."	| brow |	brow := self new.	brow setClass: aClass selector: nil.	^ self 		openBrowserView: (brow openEditString: nil)		label: 'System Browser'! !!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!fullOnClass: aClass selector: aSelector	"Open a new full browser set to class."	| brow classToUse |	classToUse := SystemBrowser default.	brow := classToUse new.	brow setClass: aClass selector: aSelector.	^ classToUse 		openBrowserView: (brow openEditString: nil)		label: brow labelString! !!Browser class methodsFor: 'instance creation' stamp: 'di 10/18/1999 22:03'!new	^super new systemOrganizer: SystemOrganization! !!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!newOnCategory: aCategory	"Browse the system category of the given name.  7/13/96 sw"	"Browser newOnCategory: 'Interface-Browser'"	| newBrowser catList |	newBrowser := self new.	catList := newBrowser systemCategoryList.	newBrowser systemCategoryListIndex: 		(catList indexOf: aCategory asSymbol ifAbsent: [^ self inform: 'No such category']).	^ self 		openBrowserView: (newBrowser openSystemCatEditString: nil)		label: 'Classes in category ', aCategory! !!Browser class methodsFor: 'instance creation' stamp: 'tk 4/18/1998 16:28'!newOnClass: aClass 	"Open a new class browser on this class."	^ self newOnClass: aClass label: 'Class Browser: ', aClass name! !!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!newOnClass: aClass label: aLabel	"Open a new class browser on this class."	| newBrowser |	newBrowser := self new.	newBrowser setClass: aClass selector: nil.	^ self 		openBrowserView: (newBrowser openOnClassWithEditString: nil)		label: aLabel! !!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!newOnClass: aClass selector: aSymbol	"Open a new class browser on this class."	| newBrowser |	newBrowser := self new.	newBrowser setClass: aClass selector: aSymbol.	^ self 		openBrowserView: (newBrowser openOnClassWithEditString: nil)		label: 'Class Browser: ', aClass name! !!Browser class methodsFor: 'instance creation' stamp: 'md 3/10/2006 21:46'!open	^self openBrowser! !!Browser class methodsFor: 'instance creation' stamp: 'jcg 10/29/2003 23:11'!openBrowser	"Create and schedule a BrowserView with default browser label. The	view consists of five subviews, starting with the list view of system	categories of SystemOrganization. The initial text view part is empty."	| br |	br := self new.	^ self		openBrowserView: (br openEditString: nil)		label: br defaultBrowserTitle.! !!Browser class methodsFor: 'instance creation' stamp: 'alain.plantec 6/19/2008 09:43'!openBrowserView: aBrowserView label: aString 	"Schedule aBrowserView, labelling the view aString."	(aBrowserView setLabel: aString) openInWorld.	^ aBrowserView model! !!Browser class methodsFor: 'instance creation' stamp: 'nk 6/2/2004 12:55'!systemOrganizer: anOrganizer	^(super new)		systemOrganizer: anOrganizer;		yourself! !!Browser class methodsFor: 'window color' stamp: 'AlainPlantec 12/16/2009 22:20'!patchworkUIThemeColor 	"Answer a default color for UI themes that make use of different colors for Browser, MessageList etc..."	^ Color paleGreen	! !Browser initialize!